Code

# Chargement des bibliothèques nécessaires avec vérification
required_packages <- c(
  "readr",
  "dplyr",
  "stringr",
  "tm",
  "tokenizers",
  "udpipe",
  "ggplot2",
  "tidyr",
  "wordcloud",
  "reshape2",
  "syuzhet",
  "sentimentr",
  "textdata",
  "quanteda",
  "glmnet",
  "textstem",
  "purrr",
  "fmsb",
  "lda",
  "topicmodels",
  "LDAvis",
  "ldatuning",
  "RColorBrewer",
  "servr"
)

invisible(lapply(required_packages, function(pkg) {
  if (!require(pkg, character.only = TRUE)) {
    install.packages(pkg, dependencies = TRUE)
    library(pkg, character.only = TRUE)
  }
}))
## Le chargement a nécessité le package : readr
## Le chargement a nécessité le package : dplyr
## 
## Attachement du package : 'dplyr'
## Les objets suivants sont masqués depuis 'package:stats':
## 
##     filter, lag
## Les objets suivants sont masqués depuis 'package:base':
## 
##     intersect, setdiff, setequal, union
## Le chargement a nécessité le package : stringr
## Le chargement a nécessité le package : tm
## Le chargement a nécessité le package : NLP
## Le chargement a nécessité le package : tokenizers
## Le chargement a nécessité le package : udpipe
## Le chargement a nécessité le package : ggplot2
## 
## Attachement du package : 'ggplot2'
## L'objet suivant est masqué depuis 'package:NLP':
## 
##     annotate
## Le chargement a nécessité le package : tidyr
## Le chargement a nécessité le package : wordcloud
## Le chargement a nécessité le package : RColorBrewer
## Le chargement a nécessité le package : reshape2
## 
## Attachement du package : 'reshape2'
## L'objet suivant est masqué depuis 'package:tidyr':
## 
##     smiths
## Le chargement a nécessité le package : syuzhet
## Le chargement a nécessité le package : sentimentr
## 
## Attachement du package : 'sentimentr'
## L'objet suivant est masqué depuis 'package:syuzhet':
## 
##     get_sentences
## Le chargement a nécessité le package : textdata
## Le chargement a nécessité le package : quanteda
## Package version: 4.1.0
## Unicode version: 15.1
## ICU version: 74.1
## Parallel computing: 16 of 16 threads used.
## See https://quanteda.io for tutorials and examples.
## 
## Attachement du package : 'quanteda'
## L'objet suivant est masqué depuis 'package:tm':
## 
##     stopwords
## Les objets suivants sont masqués depuis 'package:NLP':
## 
##     meta, meta<-
## Le chargement a nécessité le package : glmnet
## Le chargement a nécessité le package : Matrix
## 
## Attachement du package : 'Matrix'
## Les objets suivants sont masqués depuis 'package:tidyr':
## 
##     expand, pack, unpack
## Loaded glmnet 4.1-8
## Le chargement a nécessité le package : textstem
## Le chargement a nécessité le package : koRpus.lang.en
## Le chargement a nécessité le package : koRpus
## Le chargement a nécessité le package : sylly
## For information on available language packages for 'koRpus', run
## 
##   available.koRpus.lang()
## 
## and see ?install.koRpus.lang()
## 
## Attachement du package : 'koRpus'
## Les objets suivants sont masqués depuis 'package:quanteda':
## 
##     tokens, types
## L'objet suivant est masqué depuis 'package:tm':
## 
##     readTagged
## L'objet suivant est masqué depuis 'package:readr':
## 
##     tokenize
## Le chargement a nécessité le package : purrr
## Le chargement a nécessité le package : fmsb
## Le chargement a nécessité le package : lda
## Le chargement a nécessité le package : topicmodels
## Le chargement a nécessité le package : LDAvis
## Le chargement a nécessité le package : ldatuning
## Le chargement a nécessité le package : servr
# Chargement des données
data <- readxl::read_excel("Examen_TM24_ArchivePolice.xlsx")

# Fonction pour nettoyer le texte avec gestion des accents
clean_text <- function(data) {
  data$text <- data$text %>%
    tolower() %>%  
    iconv(from = "UTF-8", to = "ASCII//TRANSLIT") %>% 
    str_replace_all("l'|d'|qu'|c'|n'|t'|m'|s'|'|l’|d’|qu’|c’|n’|t’|m’|s’|’|à",
                    "") %>%  
    removePunctuation() %>% 
    removeNumbers() %>%  
    removeWords(stopwords("fr")) %>% 
    stripWhitespace() %>%  
    textstem::lemmatize_strings() 
  
  return(data)
}

# Fonction pour annoter le texte avec udpipe et ajouter des métadonnées
annotate_text <- function(data, model) {
  annotations <- udpipe_annotate(model, x = data$text, doc_id = data$id_document)
  annotations <- as.data.frame(annotations)
  return(annotations)
}

# Téléchargement et chargement du modèle udpipe
udpipe_model <- function(language = "french") {
  model_path <- paste0(language, "-ud-2.5-191206.udpipe")
  if (!file.exists(model_path)) {
    model <- udpipe_download_model(language = language)
    udpipe_load_model(file = model$file_model)
  } else {
    udpipe_load_model(file = model_path)
  }
}

# Fonction pour tokeniser, lemmatiser, POS-tagger un texte, et nettoyer le texte
process_text <- function(text, ud_model) {
  # Étape 1 : Annoter le texte (tokenisation, POS-tagging, lemmatisation)
  annotated_df <- annotate_text(text, ud_model)
  
  # Étape 2a : Garder uniquement les noms, verbes et noms propres
  filtered_df <- annotated_df %>%
    filter(upos %in% c("NOUN", "VERB", "PROPN"))
  
  # Étape 2b : Retirer les mots avec une fréquence de 1 (hapax legomena)
  word_freq <- filtered_df %>%
    count(lemma, sort = TRUE) %>%
    filter(n > 1) 
  
  filtered_df <- filtered_df %>%
    filter(lemma %in% word_freq$lemma)
  
  # Etape 2c : Retirer les mots les plus fréquents en Français
  frequent_words <- c(
    "faire",
    "être",
    "avoir",
    "dire",
    "aller",
    "pouvoir",
    "voir",
    "savoir",
    "vouloir",
    "devoir",
    "mettre"
  )
  filtered_df <- filtered_df %>%
    filter(!lemma %in% frequent_words)
  
  # Étape 3 : Concaténer les noms propres consécutifs (PROPN)
  filtered_df <- filtered_df %>%
    mutate(next_upos = lead(upos), next_token = lead(token)) %>%
    mutate(concat_token = ifelse(
      upos == "PROPN" & next_upos == "PROPN",
      paste(token, next_token),
      token
    )) %>%
    filter(upos != "PROPN" |
             lead(upos) != "PROPN")
  
  return(filtered_df)
}

# Fonction pour créer une matrice document-mot (DTM)
create_dtm <- function(filtered_df,
                       doc_id_column = "doc_id",
                       lemma_column = "lemma") {
  term_frequencies <- document_term_frequencies(filtered_df, document = doc_id_column, term = lemma_column)
  dtm <- document_term_matrix(term_frequencies)
  return(dtm)
}

# Fonction pour trouver le nombre optimal de thèmes (topics)
find_best_num_topics <- function(dtm) {
  result <- FindTopicsNumber(
    dtm,
    topics = seq(2, 50, by = 2),
    metrics = c("CaoJuan2009", "Arun2010", "Griffiths2004", "Deveaud2014"),
    method = "Gibbs",
    control = list(seed = 77),
    mc.cores = 50L,
    verbose = TRUE
  )
  
  print(result)
  
  # Visualisation des résultats avec FindTopicsNumber_plot
  FindTopicsNumber_plot(result)
  return(result)
}

# Modélisation thématique avec LDA avec ajustement des hyperparamètres
perform_lda <- function(dtm,
                        num_topics,
                        alpha = NULL,
                        iterations = 2000) {
  control_list <- list(seed = 1234, iter = iterations)
  
  if (!is.null(alpha))
    control_list$alpha <- alpha
  
  lda_model <- LDA(dtm,
                   k = num_topics,
                   method = "Gibbs",
                   control = control_list)
  return(lda_model)
}

# Fonction pour visualiser la distribution des thèmes et des mots, et ajouter un nuage de mots par thème avec un titre
visualize <- function(lda_model, dtm, best_num_topics, num_words = 20) {
  # Visualisation LDAvis
  json <- createJSON(
    phi = posterior(lda_model)$terms,
    theta = posterior(lda_model)$topics,
    doc.length = rowSums(as.matrix(dtm)),
    vocab = colnames(as.matrix(dtm)),
    term.frequency = colSums(as.matrix(dtm))
  )
  serVis(json)
  
  # Extraction des termes par thème
  terms_per_topic <- terms(lda_model, num_words)
  num_topics <- best_num_topics
  
  # Créer un nuage de mots pour chaque thème
  for (i in 1:num_topics) {
    topic_terms <- terms_per_topic[, i]
    term_frequencies <- posterior(lda_model)$terms[i, ]
    topic_freq <- term_frequencies[colnames(dtm) %in% topic_terms]
    
    word_freq_df <- data.frame(word = names(topic_freq), freq = topic_freq)
    
    wordcloud::wordcloud(
      words = word_freq_df$word,
      freq = word_freq_df$freq,
      min.freq = 1,
      max.words = num_words,
      random.order = FALSE,
      scale = c(3, 0.8),
      colors = brewer.pal(8, "Dark2"),
      rot.per = 0,
      family = "serif"
    )
    
    title(
      main = paste("Nuage de mots pour le thème", i),
      col.main = "black",
      cex.main = 1.5
    )
  }
}

# Fonction pour générer des noms de thèmes avec pondération des termes fréquents
generate_theme_names <- function(lda_model, num_words = 3) {
  terms_per_topic <- terms(lda_model, num_words)
  num_topics <- ncol(terms_per_topic)
  theme_names <- character(num_topics)
  
  for (i in 1:num_topics) {
    topic_terms <- terms_per_topic[, i]
    term_importance <- posterior(lda_model)$terms[i, ]
    sorted_terms <- sort(term_importance[topic_terms], decreasing = TRUE)
    important_terms <- names(sorted_terms)[1:num_words]
    theme_names[i] <- paste(important_terms, collapse = ", ")
  }
  
  return(theme_names)
}

# Fonction pour extraire la distribution des thèmes par document
get_document_topics <- function(lda_model, dtm) {
  topic_distribution <- posterior(lda_model)$topics
  document_topics_df <- as.data.frame(topic_distribution)
  document_topics_df$doc_id <- rownames(dtm)
  return(document_topics_df)
}

# Fonction de visualisation des thèmes par document
visualize_document_topics <- function(document_topics) {
  molten_data <- melt(document_topics, id.vars = "doc_id")
  colors <- RColorBrewer::brewer.pal(n = length(unique(molten_data$variable)), name = "Set3")
  
  ggplot(molten_data, aes(x = doc_id, y = value, fill = variable)) +
    geom_bar(stat = "identity", position = "dodge") +
    labs(
      title = "Distribution des Thèmes par Document",
      x = "ID du Document",
      y = "Probabilité de Thème",
      fill = "Thèmes"
    ) +
    scale_fill_manual(values = colors) +
    theme_minimal(base_size = 14) +
    theme(
      axis.text.x = element_text(
        angle = 45,
        hjust = 1,
        vjust = 1
      ),
      plot.title = element_text(
        hjust = 0.5,
        size = 16,
        face = "bold"
      ),
      panel.grid.major = element_line(color = "gray90"),
      panel.grid.minor = element_blank()
    )
}

# Fonction pour visualiser la distribution des thèmes dans les documents
visualize_topic_distribution <- function(document_topics) {
  molten_data <- document_topics %>%
    pivot_longer(-doc_id, names_to = "topic", values_to = "topic_prop") %>%
    mutate(topic = as.numeric(gsub("V", "", topic)))

  ggplot(molten_data, aes(x = topic, y = topic_prop)) +
    geom_point(color = "darkblue", size = 2, alpha = 0.7) +
    geom_linerange(aes(ymin = 0, ymax = topic_prop), color = "lightblue", size = 1) +
    facet_wrap(~ doc_id, scales = "free_y") +
    scale_y_continuous(limits = c(0, 1)) +
    labs(
      title = "Distribution des Thèmes dans les Documents",
      x = "ID de Thème",
      y = "Proportion de Thème"
    ) +
    theme_minimal(base_size = 15) +
    theme(
      panel.border = element_rect(fill = NA, color = "gray50", size = 0.5),
      strip.background = element_rect(fill = "lightgray"),
      strip.text = element_text(face = "bold"),
      axis.text.x = element_text(angle = 45, hjust = 1),
      plot.title = element_text(hjust = 0.5, face = "bold", size = 18),
      panel.grid.major = element_line(color = "gray90"),
      panel.grid.minor = element_blank()
    )
}

# Code pour exécuter le pipeline complet

# Charger et nettoyer les données
data <- clean_text(data)

# Charger le modèle UDPipe français
ud_model <- udpipe_model(language = "french")
## Downloading udpipe model from https://raw.githubusercontent.com/jwijffels/udpipe.models.ud.2.5/master/inst/udpipe-ud-2.5-191206/french-gsd-ud-2.5-191206.udpipe to C:/Users/chall/OneDrive/Documents/S5/Big Data/TP/TD Noté/french-gsd-ud-2.5-191206.udpipe
##  - This model has been trained on version 2.5 of data from https://universaldependencies.org
##  - The model is distributed under the CC-BY-SA-NC license: https://creativecommons.org/licenses/by-nc-sa/4.0
##  - Visit https://github.com/jwijffels/udpipe.models.ud.2.5 for model license details.
##  - For a list of all models and their licenses (most models you can download with this package have either a CC-BY-SA or a CC-BY-SA-NC license) read the documentation at ?udpipe_download_model. For building your own models: visit the documentation by typing vignette('udpipe-train', package = 'udpipe')
## Downloading finished, model stored at 'C:/Users/chall/OneDrive/Documents/S5/Big Data/TP/TD Noté/french-gsd-ud-2.5-191206.udpipe'
# Processus de traitement et annotation des données
filtered_df <- process_text(data, ud_model)

# Créer une DTM
dtm <- create_dtm(filtered_df)

# Trouver le meilleur nombre de thèmes
result_bestK <- find_best_num_topics(dtm)
## fit models... done.
## calculate metrics:
##   CaoJuan2009... done.
##   Arun2010... done.
##   Griffiths2004... done.
##   Deveaud2014... done.
##    topics CaoJuan2009  Arun2010 Griffiths2004 Deveaud2014
## 1      50  0.23738726 4.8597148     -10711.86   0.5025258
## 2      48  0.20912658 4.6873968     -10686.96   0.5454195
## 3      46  0.21849707 4.8875285     -10723.40   0.5429457
## 4      44  0.20512686 4.1415058     -10753.69   0.5662875
## 5      42  0.20881932 3.7238606     -10649.18   0.5814189
## 6      40  0.20269124 3.4229149     -10691.27   0.6048184
## 7      38  0.18212705 3.4761344     -10666.53   0.6354470
## 8      36  0.18936562 3.0722266     -10696.81   0.6414804
## 9      34  0.16311713 2.5863278     -10619.57   0.7151706
## 10     32  0.15697028 2.6607597     -10614.72   0.7273517
## 11     30  0.16686073 2.0252619     -10586.97   0.7514888
## 12     28  0.15444683 1.8665580     -10596.90   0.7775787
## 13     26  0.14851117 1.5583916     -10590.54   0.8322471
## 14     24  0.14144590 1.4144934     -10575.76   0.8672389
## 15     22  0.14070954 1.2599108     -10533.26   0.8822142
## 16     20  0.13837064 0.8800750     -10536.00   0.9319657
## 17     18  0.12576543 0.3440858     -10491.81   1.0144564
## 18     16  0.11876436 0.5333767     -10544.67   1.0451795
## 19     14  0.12272245 0.5843928     -10468.85   1.1293916
## 20     12  0.10421952 0.4893028     -10579.15   1.1856917
## 21     10  0.10207298 0.5550099     -10496.37   1.2598471
## 22      8  0.10653170 0.8320211     -10567.37   1.3350242
## 23      6  0.10134227 1.4291331     -10730.83   1.4274152
## 24      4  0.09104951 2.1950627     -11022.46   1.5396260
## 25      2  0.21851426 4.2258309     -11788.59   1.5444426
## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## ℹ The deprecated feature was likely used in the ldatuning package.
##   Please report the issue at <https://github.com/nikita-moor/ldatuning/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

# D'après les résultats de FindTopicsNumber, le meilleur nombre de thèmes est entre 6 et 12, donc j'ai choisi le maximum pour une meilleure granularité
best_num_topics <- 12

# Modélisation LDA avec le nombre optimal de thèmes (ou ajuster selon les résultats)
lda_model <- perform_lda(dtm, best_num_topics, alpha = 0.1, iterations = 3000)

# Générer les noms des thèmes
theme_names <- generate_theme_names(lda_model, num_words = 5)
print(theme_names)
##  [1] "veyrac, ete, hôtel, police, sequestration"              
##  [2] "place, commissaire, consequence, operation, communiste" 
##  [3] "requier, police, partir, plan, chatellerault"           
##  [4] "examen, personne, à, encourir, individu"                
##  [5] "affaire, contreespionnage, espionnage, renseignement, à"
##  [6] "tueur, an, eter, affaire, journaliste"                  
##  [7] "service, guerre, renseignement, scr, france"            
##  [8] "reseau, pcf, agir, fantomas, militir"                   
##  [9] "roi, madame, eter, messe, mmer"                         
## [10] "france, victime, et, homme, patricier"                  
## [11] "affaire, homme, baron, agir, arme"                      
## [12] "main, vol, samedi, ete, août"
# Visualiser les thèmes
visualize(lda_model, dtm, best_num_topics, 15)

# Extraire la distribution des thèmes par document
document_topics <- get_document_topics(lda_model, dtm)

# Visualiser la distribution des thèmes par document
visualize_document_topics(document_topics)

# Visuliser la distributions de thèmes par document
document_topics <- get_document_topics(lda_model, dtm)
visualize_topic_distribution(document_topics)
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: The `size` argument of `element_rect()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

/

Explication du code et de la méthode utilisé

Pour structurer les archives sur des affaires criminelles, j’ai utilisé l’algorithme de Latent Dirichlet Allocation (LDA) qui est une méthode de modélisation thématique non supervisée. Voici une explication de la méthode et du code utilisé :

  1. Préparation des données :
    • Le texte est nettoyé avec la fonction clean_text() qui effectue la mise en minuscules, la normalisation des accents, la suppression de la ponctuation, des chiffres et des mots vides (stopwords).
    • Le texte est ensuite annoté avec UDPipe pour la tokenisation, l’étiquetage morpho-syntaxique (POS-tagging) et la lemmatisation.
  2. Traitement du texte :
    • La fonction process_text() filtre les mots pour ne garder que les noms, verbes et noms propres.
    • Elle supprime les hapax (mots apparaissant une seule fois) et les mots les plus fréquents en français.
    • Les noms propres consécutifs sont concaténés pour préserver les entités nommées.
  3. Création de la matrice document-terme (DTM) :
    • La fonction create_dtm() crée une représentation matricielle des documents où chaque ligne représente un document et chaque colonne un terme.
  4. Détermination du nombre optimal de thèmes :
    • La fonction find_best_num_topics() utilise plusieurs métriques (CaoJuan2009, Arun2010, Griffiths2004, Deveaud2014) pour estimer le nombre optimal de thèmes.
    • L’analyse du graphique généré par cette fonction suggère qu’un nombre optimal de sujets se situe probablement entre 6 et 12. Voici l’interprétation détaillée :
      1. CaoJuan2009 et Arun2010 (métriques à minimiser) :
        • Atteignent leurs valeurs minimales autour de 6-8 sujets.
        • Après ce point, elles commencent à augmenter progressivement.
      2. Griffiths2004 (métrique à maximiser) :
        • Atteint son pic autour de 10-12 sujets.
        • Après cela, il se stabilise avec une légère tendance à la baisse.
      3. Deveaud2014 (métrique à maximiser) :
        • Bien qu’il décroisse continuellement, la pente est plus raide avant 10-12 sujets, puis devient plus douce.
    • Cette analyse multi-métrique permet de choisir un nombre de thèmes qui offre un bon compromis entre les différentes mesures de qualité.
  5. Modélisation LDA :
    • Sur la base de cette analyse, la fonction perform_lda() applique l’algorithme LDA avec 12 thèmes, ce qui se situe dans la plage optimale identifiée.
    • Les hyperparamètres sont ajustés (alpha = 0.1, iterations = 3000) pour améliorer la cohérence des thèmes.
  6. Visualisation :
    • La fonction visualize() crée une visualisation interactive LDAvis des thèmes et des termes (pas disponible dans le html).
    • Elle génère également des nuages de mots pour chaque thème.
  7. Analyse des résultats :
    • La fonction generate_theme_names() propose des noms pour chaque thème basés sur les termes les plus importants.
    • get_document_topics() extrait la distribution des thèmes pour chaque document.
    • visualize_document_topics() et visualize_topic_distribution() créent des graphiques montrant la répartition des thèmes dans les documents.

Cette méthode permet de capturer efficacement la structure thématique des archives criminelles tout en évitant une granularité excessive (trop de thèmes) ou insuffisante (trop peu de thèmes). Cela devrait se traduire par des thèmes plus cohérents et plus facilement interprétables, facilitant ainsi la structuration et l’analyse des archives policières.

L’utilisation de cette approche basée sur des données pour choisir le nombre de thèmes, plutôt que de se fier à une intuition ou à un choix arbitraire, renforce la validité scientifique de notre analyse et devrait conduire à une meilleure compréhension de la structure thématique des archives criminelles.